home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 September (IDG) / Sep99.iso / Shareware World / Utilities / Text Processing / Alpha / Tcl / SystemCode / dialogs.tcl < prev    next >
Encoding:
Text File  |  1999-04-26  |  63.5 KB  |  2,178 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*- (nowrap)
  2.  # ###################################################################
  3.  #  Alpha - new Tcl folder configuration
  4.  # 
  5.  #  FILE: "dialogs.tcl"
  6.  #                                    created: 12/1/96 {5:36:49 pm} 
  7.  #                                last update: 04/26/1999 {16:48:29 PM} 
  8.  #  Author: Vince Darley
  9.  #  E-mail: <darley@fas.harvard.edu>
  10.  #    mail: Division of Engineering and Applied Sciences, Harvard University
  11.  #          Oxford Street, Cambridge MA 02138, USA
  12.  #     www: <http://www.fas.harvard.edu/~darley/>
  13.  #  
  14.  # Much copyright (c) 1997-1999  Vince Darley, all rights reserved, 
  15.  # rest Pete Keleher, Johan Linde.
  16.  # 
  17.  # Reorganisation carried out by Vince Darley with much help from Tom 
  18.  # Fetherston, Johan Linde and suggestions from the Alpha-D mailing list.  
  19.  # Alpha is shareware; please register with the author using the register 
  20.  # button in the about box.
  21.  #  
  22.  #  Description: 
  23.  # 
  24.  # Much more flexible dialogs for querying the user about flags and
  25.  # vars.  These may be global, mode-dependent, or package-dependent.
  26.  # 
  27.  # Things you may wish to do:
  28.  # 
  29.  #  dialog::pkg_options Pkg
  30.  #  
  31.  # creates a dialog for all array entries 'PkgmodeVars'.  These
  32.  # must have been previously declared using 'newPref'.  These
  33.  # variables are _not_ copied into the global scope; only
  34.  # existing as array entries.
  35.  # 
  36.  # Note that rather than setting up traces on variables, you are
  37.  # often better off using the optional proc argument to newPref;
  38.  # the name of a procedure to call if that element is changed by
  39.  # the user.
  40.  # 
  41.  # The old procedure 'newModeVar' is obsolete.  Use the
  42.  # new procedure 'newPref'.  Why?  It has optional arguments
  43.  # which allow you to declare:
  44.  # 
  45.  #  lists
  46.  #  indexed lists
  47.  #  folders
  48.  #  files
  49.  #  bindings
  50.  #  menu-bindings
  51.  #  applications
  52.  #  variable-list elements
  53.  #  array elements
  54.  #  
  55.  # all of which can be set using the same central mode/global
  56.  # dialogs.
  57.  #  
  58.  # It also lets you add an optional procedure to call when an
  59.  # item changes...  Also if Alpha upgrades to Tcl 8 and namespaces, 
  60.  # it is easy to modify that central procedure to fit everything 
  61.  # with the new scheme.
  62.  # 
  63.  # Most modes will just want to declare their vars using newPref.  
  64.  # There is usually no need to do _anything_ else.
  65.  # 
  66.  # ---
  67.  # 
  68.  # The prefs dialog procs below were based upon Pete Keleher's 
  69.  # originals.
  70.  # ###################################################################
  71.  ##
  72.  
  73. namespace eval dialog {}
  74. namespace eval global {}
  75. namespace eval flag {}
  76.  
  77.  
  78.     
  79. # ◊◊◊◊ Toplevel dialog procedures ◊◊◊◊ #
  80.  
  81. ## 
  82.  # -------------------------------------------------------------------------
  83.  # 
  84.  # "dialog::pkg_options" --
  85.  # 
  86.  #  Make a dialog for the given package, with 'title' for the dialog box.
  87.  #  'not_global' indicates the variables are never copied into the global
  88.  #  scope, remaining in their array ${pkg}modeVars (or '$var' if it is given)
  89.  # 
  90.  # Results:
  91.  #  Nothing
  92.  # 
  93.  # Side effects:
  94.  #  May modify any of the given package's variables.
  95.  # 
  96.  # --Version--Author------------------Changes-------------------------------
  97.  #    1.0     <darley@fas.harvard.edu> original
  98.  # -------------------------------------------------------------------------
  99.  ##
  100. proc dialog::pkg_options {pkg {title ""} {not_global 1} {var ""}} {
  101.     if {!$not_global} {
  102.     # make sure the package variables are global
  103.     global ${pkg}modeVars
  104.     if {[info exists ${pkg}modeVars]} {
  105.         foreach v [array names ${pkg}modeVars] {
  106.         global $v
  107.         set $v [set ${pkg}modeVars($v)]
  108.         }
  109.     }
  110.     }
  111.     if {$title == ""} { 
  112.     set title "Preferences for the '[quote::Prettify $pkg]' package" 
  113.     }
  114.     if {$not_global} {
  115.     global dialog::_not_global_flag
  116.     if {$var == ""} {
  117.         set dialog::_not_global_flag ${pkg}modeVars
  118.     } else {
  119.         set dialog::_not_global_flag $var
  120.     }
  121.     }
  122.     set err [catch {dialog::modifyModeFlags $title $not_global $pkg} result]
  123.     if {$not_global} {
  124.     global dialog::_not_global_flag
  125.     set dialog::_not_global_flag ""
  126.     }
  127.     if {$err} {
  128.     error $result
  129.     }
  130. }
  131. proc dialog::edit_array {var {title ""}} {
  132.     if {$title == ""} {set title "Contents of '$var' array"}
  133.     dialog::pkg_options "" $title 1 $var
  134. }
  135. ## 
  136.  # -------------------------------------------------------------------------
  137.  # 
  138.  # "dialog::variable" --
  139.  # 
  140.  #  Ask for a value, with default given by the given variable, and using
  141.  #  that variable's type (list, file, ...) as a constraint.
  142.  #  
  143.  #  Currently assumes the variable is a list var, but this will change.
  144.  # -------------------------------------------------------------------------
  145.  ##
  146. proc dialog::variable {var {title ""}} {
  147.     if {$title == ""} { set title [quote::Prettify $var] }
  148.     return [dialog::optionMenu $title [flag::options $var] \
  149.       [uplevel [list set $var]]]
  150. }
  151.  
  152.  
  153. ## 
  154.  # -------------------------------------------------------------------------
  155.  # 
  156.  # "dialog::paged" --
  157.  # 
  158.  #  Under development.  Not yet usable!
  159.  # -------------------------------------------------------------------------
  160.  ##
  161. proc dialog::paged {args} {
  162.     getOpts {-pageproc}
  163.     set pages [lindex $args 0]
  164.     lappend dialog -m [concat [lindex $pages 0] $pages] 100 10 200 40
  165.     set xmax -1
  166.     set ymax -1
  167.     set i 1
  168.     foreach page $pages {
  169.     lappend dialog -n $page
  170.     set contents [$opts(-pageproc) $page 20 50]
  171.     set x [lindex $contents 0]
  172.     set y [lindex $contents 1]
  173.     set contents [lindex $contents 2]
  174.     if {$x > $xmax} { set xmax $x }
  175.     if {$y > $ymax} { set ymax $x }
  176.     incr i
  177.     }
  178.     incr ymax 15
  179.     incr xmax 20
  180.     eval dialog -w $xmax -h [expr {$ymax+40}] [dialog::okcancel 10 ymax] $dialog
  181. }
  182.  
  183. proc helperApps {} {
  184.     set sigs [info globals *Sig]
  185.     regsub -all {Sig} $sigs {} sigs
  186.     set sig [listpick -p "Change/inspect which helper?" [lsort $sigs]]
  187.     set sig ${sig}Sig
  188.     global $sig
  189.     if {![info exists $sig]} { set $sig "" }
  190.     set nsig [dialog::askFindApp $sig [set $sig]]
  191.     if {$nsig != "" && [set $sig] != $nsig} {
  192.     set $sig $nsig
  193.     global modifiedVars
  194.     lappend modifiedVars $sig
  195.     }
  196. }
  197.  
  198. proc suffixMappings {} {
  199.     global filepats
  200.     
  201.     set l1 5
  202.     set w1 38
  203.     set l2 [expr {$l1 + $w1 + 5}]
  204.     set w2 200
  205.     set h 18
  206.     set top 5
  207.     set mar 5
  208.     
  209.     set modes [lsort -ignore [array names filepats]]
  210.     set len [expr {[llength $modes] + 1}]
  211.     set modes1 [lrange $modes 0 [expr {$len/2 - 1}]]
  212.     set modes2 [lrange $modes [expr {$len/2}] end]
  213.     
  214.     foreach m $modes1 {
  215.     lappend items -t $m $l1 $top [expr {$l1 + $w1}] [expr {$top + $h}]
  216.     lappend items -e $filepats($m) $l2 $top [expr {$l2 + $w2}] \
  217.       [expr {$top + $h - 2}]
  218.     incr top [expr {$h + $mar}]
  219.     }
  220.     
  221.     set top2 5
  222.     set l1 [expr {$l2 + $w2 + 20}]
  223.     set l2 [expr {$l1 + $w1 + 5}]
  224.     foreach m $modes2 {
  225.     lappend items -t $m $l1 $top2 [expr {$l1 + $w1}] [expr {$top2 + $h}]
  226.     lappend items -e $filepats($m) $l2 $top2 [expr {$l2 + $w2}] \
  227.       [expr {$top2 + $h - 2}]
  228.     incr top2 [expr {$h + $mar}]
  229.     }
  230.     
  231.     if {$top2 > $top} {
  232.     set top $top2
  233.     }
  234.     incr top $mar
  235.     
  236.     set l1 5
  237.     lappend buts -b OK $l1 $top [expr {$l1 + 60}] [expr {$top + 20}]
  238.     lappend buts -b Cancel [expr {$l1 + 100}] $top [expr {$l1 + 160}] \
  239.       [expr {$top + 20}]
  240.     
  241.     set res [eval "dialog -w [expr {$l2 + $w2 + 10}] -h [expr {$top + 27}]" \
  242.       $buts $items]
  243.     
  244.     if {[lindex $res 0]} {
  245.     set res [lrange $res 2 end]
  246.     
  247.     set changed ""
  248.     foreach m [lsort -ignore [array names filepats]] {
  249.         if {$filepats($m) != [lindex $res 0]} {
  250.         lappend changed [list $m [lindex $res 0]]
  251.         }
  252.         set res [lrange $res 1 end]
  253.     }
  254.     
  255.     foreach pair $changed {
  256.         eval addArrDef filepats [lrange $pair 0 1]
  257.         set filepats([lindex $pair 0]) [lindex $pair 1]
  258.     }
  259.     }
  260.     mode::updateSuffixes
  261. }
  262. proc dialog::mode {flags vars {title ""}} {
  263.     set lim [expr {10 - [llength $flags]/4}]
  264.     if {[llength $vars] > $lim } {
  265.     set args {}
  266.     set nvars [llength $vars]
  267.     set j 0
  268.     for {set i 0} {$i < $nvars} {incr i $lim ; set lim 10} {
  269.         lappend args [list "Page [incr j] of ${title}" $flags \
  270.           [lrange $vars $i [expr {$i+$lim -1}]]]
  271.         set flags ""
  272.     }
  273.     dialog::multipage $args
  274.     } else {
  275.     dialog::onepage $flags $vars $title
  276.     }
  277. }
  278. ## 
  279.  # -------------------------------------------------------------------------
  280.  # 
  281.  # "dialog::modifyModeFlags" --
  282.  # 
  283.  #  Currently 'not_global == 0' implies this is a mode, or at least that
  284.  #  the variables are stored in ${mm}modeVars(...)
  285.  #  
  286.  #  'not_global == 1' implies that the variables are stored in the
  287.  #  array given by the value of the variable 'dialog::_not_global_flag'
  288.  #  
  289.  #  Recently removed a call to mode::updateSuffixes which is not necessary
  290.  # -------------------------------------------------------------------------
  291.  ##
  292. proc dialog::modifyModeFlags {{title ""} {not_global 0} {mm ""}} {
  293.     global mode invisibleModeVars modifiedArrayElements \
  294.       dialog::_not_global_flag allFlags flag::procs
  295.     # Check whether this is a mode or package, and where variable values
  296.     # are stored, and whether that's at the global level as well as in
  297.     # an array...
  298.     if {$not_global} {
  299.     set storage ${dialog::_not_global_flag}
  300.     if {$title == ""} {
  301.         set title "Preferences for '${mm}' package"
  302.     }
  303.     } else {
  304.     if {$mm == ""} { 
  305.         set mm $mode 
  306.         if {$mm == ""} {
  307.         alertnote "No mode set!"
  308.         return
  309.         }
  310.     }
  311.     set storage ${mm}modeVars
  312.     if {$title == ""} {
  313.         set title "Preferences for '${mm}' mode"
  314.     }
  315.     }
  316.     # check for mode specific proc
  317.     if {[info commands ${mm}modifyFlags] != ""} {${mm}modifyFlags; return}
  318.     if {[info tclversion] >= 8.0} { set storage ::$storage }
  319.     set flags {}
  320.     set vars {}
  321.     global $storage ${storage}Invisible
  322.     if {[info exists $storage]} {
  323.     set unsortedNames [array names $storage]
  324.     set colors {}
  325.     set rest {}
  326.     foreach i $unsortedNames {
  327.         if {[regexp {Colou?r$} $i]} {
  328.         lappend colors $i
  329.         } else {
  330.         lappend rest $i
  331.         }
  332.     }
  333.     
  334.     foreach v [concat [lsort $rest] [lsort $colors]] {
  335.         if {[info exists invisibleModeVars($v)] \
  336.           || [info exists ${storage}Invisible($v)]} continue
  337.         
  338.         if {[lsearch -exact $allFlags $v] >= 0} {
  339.         lappend flags $v
  340.         } else {
  341.         lappend vars $v
  342.         }
  343.     }
  344.     
  345.     if {[catch {dialog::mode $flags $vars $title} values_items]} {
  346.         return
  347.     }
  348.     set res [lindex $values_items 0]
  349.     set editItems [lindex $values_items 1]
  350.     unset values_items
  351.     
  352.     foreach fset $editItems {
  353.         if {[llength $fset] > 1} {
  354.         set fset [lrange $fset 1 end]
  355.         }
  356.         foreach flag $fset {
  357.         set val [lindex $res 0]
  358.         set res [lrange $res 1 end]
  359.         dialog::postManipulate
  360.         if {$not_global} {
  361.             # it's a package which keeps its vars in the array
  362.             if {[set ${storage}($flag)] != $val} {
  363.             set ${storage}($flag) $val
  364.             lappend modifiedArrayElements [list $flag $storage]
  365.             if {[info exists flag::procs($flag)]} {
  366.                 eval [set flag::procs($flag)] [list $flag]
  367.             }
  368.             }
  369.         } else {
  370.             # modes keep a copy of their vars at the global 
  371.             # level when active
  372.             global $flag
  373.             if {[set $flag] != $val} {
  374.             set $flag $val
  375.             set ${storage}($flag) $val
  376.             lappend modifiedArrayElements [list $flag $storage]
  377.             
  378.             if {[info exists flag::procs($flag)]} {
  379.                 eval [set flag::procs($flag)] [list $flag]
  380.             }
  381.             }
  382.         }
  383.         }
  384.     }
  385.     } else {
  386.     alertnote "The '$mm' mode/package has no preference settings."
  387.     }
  388.     
  389.     hook::callAll dialog::modifyModeFlags $mm $title
  390.     
  391. }
  392.  
  393. ## 
  394.  # -------------------------------------------------------------------------
  395.  # 
  396.  # "dialog::getAKey" --
  397.  # 
  398.  #  Returns a keystring to be used for binding a key in a menu, 
  399.  #  using a nice dialog box to ask the user.
  400.  # 
  401.  #  Possible improvements: we could replace the dialog
  402.  #  box with a status-line prompt (which would allow the use of
  403.  #  getModifiers to check what keys the user pressed).
  404.  #  
  405.  #  Now handles 'prefixChar' bindings for non-menu items.
  406.  #  i.e. you can use this dialog to bind something to 'ctrl-x ctrl-s',
  407.  #  for instance.
  408.  # 
  409.  #  If the name contains '/' it is considered to be two items,
  410.  #  separated by that '/', which are to take the same binding,
  411.  #  except that one of them will use the option key.
  412.  #  
  413.  #  Similarly '//' means use shift, '///' means shift-option,
  414.  #  For instance 'dialog::getAKey close/closeAll//closeFloat /W<O'
  415.  #  would give you the menu-item for 'close' in the file menu. 
  416.  #  except these last two aren't implemented yet ;-)
  417.  # --Version--Author------------------Changes-------------------------------
  418.  #    1.0     Johan Linde         original
  419.  #    1.1     <darley@fas.harvard.edu> can do non-menu bindings too
  420.  #    1.2     <darley@fas.harvard.edu> handles arrow keys
  421.  #    1.2.1   Johan Linde        handles key pad keys
  422.  # -------------------------------------------------------------------------
  423.  ##
  424. proc dialog::getAKey {{name {}} {keystr {}} {for_menu 1}} {
  425.     global keys::func
  426.     # two lists for any other keys which look better with a text description
  427.     set otherKeys {"<No binding>" "-" Space}
  428.     set otherKeyChars [list "" "" " "]
  429.     if {!$for_menu} {
  430.     lappend otherKeys Left Right Up Down "Key pad =" \
  431.       "Key pad /" "Key pad *" "Key pad -" "Key pad +" "Key pad ."
  432.     lappend otherKeyChars "" "" "\x10" "" Kpad= \
  433.       Kpad/ Kpad* Kpad- Kpad+ Kpad.
  434.     for {set i 0} {$i < 10} {incr i} {
  435.         lappend otherKeys "Key pad $i"
  436.         lappend otherKeyChars Kpad$i
  437.     }
  438.     }
  439.     set nname $name
  440.     set shift-opt [expr {![regsub {///} $nname { so-} $nname]}]
  441.     set shift  [expr {![regsub {//} $nname { s-} $nname]}]
  442.     set option [expr {![regsub {/} $nname { o-} $nname]}]
  443.     if {[string length $keystr]} {
  444.     set values "0 0"
  445.     set mkey [keys::verboseKey $keystr normal]
  446.     if {$normal} {
  447.         lappend values "Normal Key"
  448.     } else {
  449.         lappend values $mkey
  450.         set mkey {}
  451.     }
  452.     lappend values [regexp {<U} $keystr]
  453.     lappend values [regexp {<B} $keystr]
  454.     if {!$for_menu} {
  455.         if {[regexp "«(.*)»" $keystr "" i]} {
  456.         if {$i == "e"} {
  457.             lappend values "escape"
  458.         } else {
  459.             lappend values "ctrl-$i"
  460.         }
  461.         } else {
  462.         lappend values "<none>"
  463.         }
  464.     }
  465.     if {$option} {lappend values [regexp {<I} $keystr]}
  466.     lappend values [regexp {<O} $keystr]
  467.     lappend values $mkey
  468.     } else {
  469.     set values {0 0 "" 0 0}
  470.     if {!$for_menu} { lappend values <none> }
  471.     if {$option} {lappend values 0}
  472.     lappend values 0 ""
  473.     }
  474.     if {$for_menu} {
  475.     set title "Menu key binding"
  476.     } else {
  477.     set title "Key binding"
  478.     set prefixes [keys::findPrefixChars]
  479.     foreach i $prefixes {
  480.         lappend prefix "ctrl-$i"
  481.     }
  482.     lappend prefixes e
  483.     lappend prefix "escape"
  484.     }
  485.     if {$name != ""} { append title " for '$name'" }
  486.     set usep [info exists prefix]
  487.     global alpha::modifier_keys
  488.     while {1} {
  489.     # Build box
  490.     set box "-t [list $title] 10 10 315 25  -t Key 10 40 40 55 \
  491.       -m [list [concat [list [lindex $values 2]] \
  492.       [list "Normal key"] $otherKeys ${keys::func}]] 80 40 180 57 \
  493.       -c Shift [list [lindex $values 3]] 10 70 60 85 \
  494.       -c Control [list [lindex $values 4]] 80 70 150 85"
  495.     if {$usep} {
  496.         lappend box -t Prefix 190 40 230 55  \
  497.           -m [concat [list [lindex $values 5]]  "<none>" "-" $prefix] \
  498.           235 40 315 57
  499.     }
  500.     if {$option} {
  501.         lappend box -c [lindex ${alpha::modifier_keys} 2] \
  502.           [lindex $values [expr {5 + $usep}]] 160 70 220 85
  503.     }
  504.     lappend box -c [lindex ${alpha::modifier_keys} 0] \
  505.       [lindex $values [expr {5 + $option +$usep}]] 230 70 315 85
  506.     lappend box -n "Normal key" -e [lindex $values [expr {6 + $option +$usep}]] 50 40 70 55
  507.     set values [eval [concat dialog -w 330 -h 130 -b OK 20 100 85 120 -b Cancel 105 100 170 120 $box]]
  508.     # Interpret result
  509.     if {[lindex $values 1]} {error "Cancel"}
  510.     # work around a little Tcl problem
  511.     regsub "\{\{\}" $values "\\\{" values
  512.     set elemKey [string toupper [string trim [lindex $values [expr {6 + $option +$usep}]]]]
  513.     set special [lindex $values 2]
  514.     set keyStr ""
  515.     if {[lindex $values 3]} {append keyStr "<U"}
  516.     if {[lindex $values 4]} {append keyStr "<B"}
  517.     if {$option && [lindex $values [expr {5 + $usep}]]} {append keyStr "<I"}
  518.     if {[lindex $values [expr {5 + $option +$usep}]]} {append keyStr "<O"}
  519.     if {$usep} {
  520.         set pref [lindex $values 5]
  521.         if {$pref != "<none>"} {
  522.         set i [lsearch -exact $prefix $pref]
  523.         append keyStr "«[lindex $prefixes $i]»"
  524.         }
  525.     }
  526.     if {[string length $elemKey] > 1 && $special == "Normal key"} {
  527.         alertnote "You should only give one character for key binding."
  528.     } else {
  529.         if {$for_menu} {
  530.         if {$special == "Normal key" && [text::Ascii $elemKey] > 126} {
  531.             alertnote "Sorry, can't define a key binding with $elemKey."
  532.         } elseif {$elemKey != "" && $special == "Normal key" && ($keyStr == "" || $keyStr == "<U")} {
  533.             alertnote "You must choose at least one of the modifiers control, option and command."
  534.         } elseif {![regexp {F[0-9]} $special] && $special != "Tab" && $special != "Normal key" && $special != "<No binding>" && $keyStr == ""} {
  535.             alertnote "You must choose at least one modifier."
  536.         } else {
  537.             break
  538.         }
  539.         } else {
  540.         break
  541.         }
  542.     }
  543.     }
  544.     if {$special == "<No binding>"} {set elemKey ""}
  545.     if {$special != "Normal key" && $special != "<No binding>"} {
  546.     if {[set i [lsearch -exact $otherKeys $special]] != -1} {
  547.         set elemKey [lindex $otherKeyChars $i]
  548.     } else {
  549.         set elemKey [text::Ascii [expr {[lsearch -exact ${keys::func} $special] + 97}] 1]
  550.     }
  551.     }
  552.     if {![string length $elemKey]} {
  553.     set keyStr ""
  554.     } else {
  555.     append keyStr "/$elemKey"
  556.     }    
  557.     return $keyStr
  558. }
  559.  
  560. ## 
  561.  # -------------------------------------------------------------------------
  562.  # 
  563.  # "dialog::optionMenu" --
  564.  # 
  565.  #  names is the list of items.  An item '-' is a divider, and empty items
  566.  #  are not allowed.
  567.  # -------------------------------------------------------------------------
  568.  ##
  569. proc dialog::optionMenu {prompt names {default ""} {index 0}} {
  570.     if {$default == ""} {set default [lindex $names 0]}
  571.     
  572.     set y 5
  573.     set w [expr {[string length $prompt] > 20 ? 350 : 200}]
  574.     if {[string length $prompt] > 60} { set w 500 }
  575.     
  576.     # in case we need a wide pop-up area that needs more room
  577.     set popUpWidth [eval dialog::_reqWidth $names]
  578.     set altWidth [expr {$popUpWidth + 60}]
  579.     set w [expr {$altWidth > $w ? $altWidth : $w}]
  580.     
  581.     set dialog [dialog::text $prompt 5 y [expr {int($w/6.7)}]]
  582.     incr y 10
  583.     eval lappend dialog [dialog::menu 30 y $names $default $popUpWidth]
  584.     incr y 20
  585.     eval lappend dialog [dialog::okcancel [expr {$w - 160}] y 0]
  586.     set res [eval dialog -w $w -h $y $dialog]
  587.     
  588.     if {[lindex $res 2]} { error "Cancel" } 
  589.     # cancel was pressed
  590.     if {$index} {
  591.     # we have to take out the entries correponding to pop-up 
  592.     # menu separator lines -trf
  593.     set possibilities [lremove -all $names "-"]
  594.     return [lsearch -exact $possibilities [lindex $res 0]]
  595.     } else {
  596.     return [lindex $res 0]
  597.     }
  598. }
  599.  
  600. ## 
  601.  # -------------------------------------------------------------------------
  602.  # 
  603.  # "dialog::alert" --
  604.  # 
  605.  #  Identical to 'alertnote' but copes with larger blocks of text, and
  606.  #  resizes to that text as appropriate.
  607.  # -------------------------------------------------------------------------
  608.  ##
  609. proc dialog::alert {args} {
  610.     eval [list dialog::yesno -y "Ok" -n ""] $args
  611. }
  612.  
  613. proc dialog::errorAlert {args} {
  614.     eval dialog::alert $args
  615.     error [lindex $args 0]
  616. }
  617.  
  618. ## 
  619.  # -------------------------------------------------------------------------
  620.  # 
  621.  # "dialog::yesno" --
  622.  # 
  623.  #  Make a dialog with between 1 and 3 buttons, representing '1', '0' and
  624.  #  error "Cancel" respectively.  The names of the first two can be given
  625.  #  with '-y name' and '-n name' respectively.  The cancel button is
  626.  #  only used if a '-c' flag is given (and its name is fixed).
  627.  #  
  628.  #  The procedure automatically sizes the dialog and buttons to fit the
  629.  #  enclosed text.
  630.  # -------------------------------------------------------------------------
  631.  ##
  632. proc dialog::yesno {args} {
  633.     # too long for Alpha's standard dialog
  634.     getOpts {-y -n}
  635.     set prompt [lindex $args 0]
  636.     set y 5
  637.     set w [expr {[string length $prompt] > 20 ? 350 : 200}]
  638.     if {[string length $prompt] > 60} { set w 500 }
  639.     
  640.     set dialog [dialog::text $prompt 5 y [expr {int($w/6.7)}]]
  641.     incr y 10
  642.     set x 10
  643.     if {[info exists opts(-y)] && $opts(-y) != ""} {
  644.     lappend buttons $opts(-y) "" y
  645.     } else {
  646.     lappend buttons "Yes" "" y
  647.     }
  648.     if {[info exists opts(-n)]} {
  649.     if {$opts(-n) != ""} {
  650.         lappend buttons $opts(-n) "" y
  651.     }
  652.     } else {
  653.     lappend buttons "No" "" y
  654.     }
  655.     if {[info exists opts(-c)]} {
  656.     lappend buttons "Cancel" "" y
  657.     }
  658.     eval lappend dialog [eval dialog::button $buttons]
  659.     if {$x > $w} { set w [expr {$x + 15}] }
  660.     set res [eval dialog -w $w -h $y $dialog]
  661.     if {[lindex $res 0]} {
  662.     return 1
  663.     } elseif {[lindex $res 1]} {
  664.     return 0
  665.     } else {
  666.     error "cancelled"
  667.     }
  668. }
  669.  
  670. proc dialog::password {{msg "Please enter password:"}} {
  671.     set values [dialog -w 300 -h 90 -t $msg 10 20 290 35 \
  672.       -e "" 10 40 290 42 -b OK 20 60 85 80 -b Cancel 105 60 170 80]
  673.     if {[lindex $values 2]} {error "Cancel"}
  674.     return [lindex $values 0]
  675. }
  676.  
  677. proc global::allPrefs {{which "AllPreferences"}} {
  678.     dialog::resetModified
  679.     global flagPrefs varPrefs
  680.     global::updateHelperFlags
  681.     global::updatePackageFlags
  682.     set AllPreferences [array names flagPrefs]
  683.     set InterfacePreferences {Appearance Electrics Text Tiling Window}
  684.     set Input-OutputPreferences {Backups Files Printer Tags WWW}
  685.     set SystemPreferences [lremove -l $AllPreferences \
  686.       $InterfacePreferences ${Input-OutputPreferences} Packages]
  687.     foreach nm [set [join ${which} ""]] {
  688.     lappend args [list $nm $flagPrefs($nm) $varPrefs($nm)]
  689.     }
  690.     dialog::is_global {
  691.     dialog::global_adjust_flags [dialog::multipage $args]
  692.     }
  693. }
  694.  
  695. proc dialog::preferences {menu nm} {
  696.     global flagPrefs varPrefs
  697.     if {[string match "Suffix Mappings" $nm]} {
  698.     return [suffixMappings]
  699.     } elseif {[string match "Menus And Features" $nm]} {
  700.     return [global::menusAndFeatures]
  701.     } elseif {[string match "Edit Prefs File" $nm]} {
  702.     return [global::editPrefsFile]
  703.     }
  704.     if {![info exists flagPrefs($nm)]} { 
  705.     set nm "[string toupper [string index $nm 0]][string range $nm 1 end]" 
  706.     }
  707.     if {[string match "*Preferences" $nm]} { return [global::allPrefs $nm] }
  708.     if {$nm == "Packages"} { global::updatePackageFlags }
  709.     if {$nm == "Helper Applications"} { global::updateHelperFlags }
  710.     dialog::is_global {
  711.     dialog::global_adjust_flags [dialog::onepage $flagPrefs($nm) $varPrefs($nm) "$nm preferences…"]
  712.     }
  713. }
  714.  
  715. # ◊◊◊◊ Finding applications ◊◊◊◊ #
  716.  
  717.  
  718. proc dialog::askFindApp {var sig} {
  719.     if {$sig == ""} {
  720.     set text "Currently unassigned.   Set?"
  721.     } elseif {[catch {nameFromAppl '$sig'} name]} {
  722.     set text "App w/ sig '$sig' doesn't seem to exist.   Change?"
  723.     } else {
  724.     set text "Current value is '$name'.   Change?"
  725.     }
  726.     if {[dialog::yesno $text]} {
  727.     set nsig [dialog::findApp $var $sig]
  728.     set app [nameFromAppl $nsig]
  729.     if {[dialog::yesno "Are you sure you want to set $var to '$nsig'\
  730.       (mapped to '$app')?"]} {
  731.         return $nsig
  732.     }
  733.     }
  734.     return ""
  735. }
  736.  
  737. proc dialog::findApp {var sig} {
  738.     global ${var}s modifiedVars
  739.     if {[info exists ${var}s]} {
  740.     # have a list of items
  741.     set sigs [set ${var}s]
  742.     
  743.     set s 0
  744.     foreach f $sigs {
  745.         if {![catch {nameFromAppl $f} path]} {
  746.         lappend items [file tail $path]
  747.         lappend itemsigs $f
  748.         incr s
  749.         }
  750.     }
  751.     if {$s} {
  752.         lappend items "-" "Locate manually…"
  753.         if {[catch {dialog::optionMenu "Select a new helper for '$var':" \
  754.           $items "" 1} p]} {
  755.         return ""
  756.         }
  757.         # we removed a bunch of items above, so have to look here
  758.         if {$p < $s} {
  759.         return [lindex $itemsigs $p]
  760.         }
  761.     }
  762.     if {!$s || $p >= $s} {
  763.         set nsig [dialog::_findApp $var $sig]
  764.         if {$nsig != ""} {
  765.         if {[lsearch $sigs $nsig] == -1} {
  766.             lappend ${var}s $nsig
  767.             lappend modifiedVars ${var}s
  768.         }
  769.         }
  770.     } else {
  771.         set nsig [lindex $sigs $p]
  772.     }
  773.     return $nsig
  774.     } else {
  775.     return [dialog::_findApp $var $sig]
  776.     }
  777. }
  778.  
  779. proc dialog::_findApp {var sig} {
  780.     if {[catch {getfile "Locate new helper for '$var':"} path]} { return "" }
  781.     set nsig [getFileSig $path]
  782.     set app [nameFromAppl $nsig]
  783.     if {$app != $path} {
  784.     alertnote "Appl sig '$nsig' is mapped to '$app', not '$path'. Remove the former, or rebuild your desktop."
  785.     return ""
  786.     }
  787.     return $nsig
  788. }
  789.  
  790. # ◊◊◊◊ Global/mode menus ◊◊◊◊ #
  791.  
  792. ## 
  793.  # -------------------------------------------------------------------------
  794.  # 
  795.  # "dialog::pickMenusAndFeatures" --
  796.  # 
  797.  #  Prompt the user to select menus and features either globally or
  798.  #  for a given mode.  We need to make sure that those items in
  799.  #  the mode-list which are also in the global list aren't forgotten
  800.  #  (since they are removed from the dialog).
  801.  # -------------------------------------------------------------------------
  802.  ##
  803. proc dialog::pickMenusAndFeatures {mode} {
  804.     global mode::features global::features 
  805.     set all [package::partition $mode]
  806.     set menus1 [lindex $all 0]
  807.     set menus2 [lindex $all 1]
  808.     set menus3 [lindex $all 2]
  809.     set features1 [lindex $all 3]
  810.     set features2 [lindex $all 4]
  811.     set features3 [lindex $all 5]
  812.     set all [eval concat $all]
  813.     # decide on two or three column
  814.     #set endw [expr [llength $all] > 50 ? 560 : 380]
  815.     set endw 560
  816.     set chosen ""
  817.     set notchosen ""
  818.     if {$mode == "global"} {
  819.     set current ${global::features}
  820.     set prefix "Select global #"
  821.     lappend names0 {Select global menus}
  822.     set types [list Usual "" "Other possible"]
  823.     } else {
  824.     foreach pkg [set current [set mode::features($mode)]] {
  825.         if {[lsearch -exact ${global::features} $pkg] != -1} {
  826.         lappend chosen $pkg
  827.         } else {
  828.         if {[string index $pkg 0] == "-"} {
  829.             set pkg [string range $pkg 1 end]
  830.             if {[lsearch -exact ${global::features} $pkg] != -1} {
  831.             # these are the ones which are disabled
  832.             lappend notchosen $pkg
  833.             }
  834.         }
  835.         }
  836.     }
  837.     set prefix "Select # for mode '$mode'"
  838.     lappend names0 "Select menus for mode '$mode'" 
  839.     set types [list Usual General "Other possible"]
  840.     }
  841.     set tmpcurrent $current
  842.     while 1 {
  843.     set maxh 0
  844.     set box ""
  845.     set names $names0
  846.     foreach type {menus features off} {
  847.         if {$mode == "global" && $type == "off"} {break}
  848.         set w 20
  849.         set h 45
  850.         set i 0
  851.         if {$type == "off"} {
  852.         set subm "Turn items off"
  853.         set types [list "Usually on for this mode" "Uncheck to disable"]
  854.         set off1 [lsort $chosen]
  855.         set off2 [lsort [lremove -l ${global::features} $chosen]]
  856.         set alloff [concat $off1 $off2]
  857.         } else {
  858.         regsub "\#" $prefix $type subm
  859.         }
  860.         set page 1
  861.         lappend names $subm
  862.         lappend box "-n" $subm
  863.         if {$type == "off"} {
  864.         lappend box -t "These items are currently globally on. You can turn them off just for this mode here."  10 $h [expr {$endw -20}] [expr {$h +15}]
  865.         incr h 20
  866.         }
  867.         foreach block $types {
  868.         incr i
  869.         if {[llength [set ${type}$i]] == 0} {
  870.             continue
  871.         }
  872.         if {$type == "off"} {
  873.             lappend box -t "$block:"
  874.         } else {
  875.             lappend box -t "$block $type:" 
  876.         }
  877.         lappend box 10 $h [expr {$w +160}] [expr {$h +15}]
  878.         incr h 20
  879.         foreach m [set ${type}$i] {
  880.             if {$h > 360} {
  881.             if {$h > $maxh} {set maxh $h}
  882.             incr page
  883.             lappend names "$subm page $page"
  884.             lappend box "-n" "$subm page $page"
  885.             set h 45
  886.             lappend box -t "$block $type continued..." 10 $h \
  887.               [expr {$w +260}] [expr {$h +15}]
  888.             incr h 20
  889.             }
  890.             set name [quote::Prettify $m]
  891.             if {$type == "off"} {
  892.             set tick [expr {([lsearch -exact $notchosen $m] < 0)}]
  893.             } else {
  894.             set tick [expr {([lsearch -exact $tmpcurrent $m] >= 0)}]
  895.             }
  896.             lappend box -c $name $tick $w $h  [expr {$w + 160}] [expr {$h + 15}]
  897.             incr w 180
  898.             if {$w == $endw} {set w 20; incr h 20}
  899.         }
  900.         if {$w != 20} {
  901.             incr h 30 ; set w 20
  902.         }
  903.         }
  904.         if {$h > $maxh} {set maxh $h}
  905.         
  906.     }
  907.     set h $maxh
  908.     incr h 20
  909.     set values [eval [concat dialog -w $endw -h [expr {$h + 30}] \
  910.       -b OK 20 $h 85 [expr {$h + 20}] \
  911.       -b Cancel 105 $h 170 [expr {$h + 20}]  \
  912.       -b Help [expr {$endw -200}] $h [expr {$endw - 140}] [expr {$h + 20}] \
  913.       -b Descriptions [expr {$endw -120}] $h [expr {$endw -20}] [expr {$h + 20}] \
  914.       -m [list $names] [expr {($endw - 220)/2}] 10 $endw 30 $box]]
  915.     
  916.     set names0 [list [lindex $values 4]]
  917.     if {[lindex $values 0]} {break}
  918.     if {[lindex $values 1]} {return $current}
  919.     if {[lindex $values 2]} {
  920.         dialog::describeMenusAndFeatures Help
  921.     }
  922.     if {[lindex $values 3]} {
  923.         dialog::describeMenusAndFeatures Describe
  924.     }    
  925.     set tmpcurrent ""
  926.     for {set i 0} {$i < [llength $all]} {incr i} {
  927.         if {[lindex $values [expr {$i + 5}]]} {
  928.         lappend tmpcurrent [lindex $all $i]
  929.         }
  930.     }
  931.     }
  932.  
  933.     for {set i 0} {$i < [llength $all]} {incr i} {
  934.     if {[lindex $values [expr {$i + 5}]]} {lappend chosen [lindex $all $i]}
  935.     }
  936.     if {$mode != "global"} {
  937.     for {set j 0} {$j < [llength [set global::features]]} {incr i ; incr j} {
  938.         if {![lindex $values [expr {$i + 5}]]} {
  939.         # turned one off
  940.         set itm [lindex $alloff $j]
  941.         if {[set idx [lsearch -exact $chosen $itm]] != -1} {
  942.             set chosen [lreplace $chosen $idx $idx "-$itm"]
  943.         } else {
  944.             lappend chosen "-$itm"
  945.         }
  946.         } 
  947.     }
  948.     }
  949.     return $chosen
  950. }
  951.  
  952. proc dialog::describeMenusAndFeatures {{what "Help"}} {
  953.     set all [package::partition]
  954.     set okmenu [lindex $all 0]
  955.     set okfeature [lindex $all 1]
  956.     set okmode [lindex $all 2]
  957.     set all [eval concat $all]
  958.     # decide on two or three column
  959.     set endw [expr {[llength $all] > 50 ? 560 : 380}]
  960.     if {$what == "Help"} {
  961.     set prefix "Read help for a #"
  962.     } else {
  963.     set prefix "Describe a #"
  964.     }
  965.     foreach m {menu feature mode} {
  966.     regsub "\#" $prefix $m subm
  967.     lappend names $subm
  968.     }
  969.     lappend box -m [concat [list [lindex $names 0]] $names] \
  970.       [expr {($endw - 150)/2}] 10 $endw 30
  971.     set maxh 0
  972.     set wincr 160
  973.     foreach type {menu feature mode} {
  974.     set w 20
  975.     set h 45
  976.     regsub "\#" $prefix $type subm
  977.     lappend box "-n" $subm
  978.     if {$type == "mode"} {set wincr 70}
  979.     foreach m [set ok$type] {
  980.         set name [quote::Prettify $m]
  981.         lappend box -b $name $w $h [expr {$w + $wincr}] [expr {$h + 15}]
  982.         incr w [expr {$wincr +20}]
  983.         if {$w == $endw} {set w 20; incr h 20}
  984.     }
  985.     if {$w > 20} {set w 20; incr h 20}
  986.     if {$h > $maxh} {set maxh $h}
  987.     }
  988.     set h $maxh
  989.     incr h 20
  990.     while 1 {
  991.     set values [eval [concat dialog -w $endw -h [expr {$h + 30}] \
  992.       -b OK 20 $h 85 [expr {$h + 20}] $box]]
  993.     if {[lindex $values 0]} {return}
  994.     # we hit a button
  995.     for {set i 0} {$i < [llength $all]} {incr i} {
  996.         if {[lindex $values [expr {$i + 2}]]} {
  997.         if {$what == "Help"} {
  998.             package::helpFile [lindex $all $i]
  999.         } else {
  1000.             package::describe [lindex $all $i]
  1001.         }
  1002.         break
  1003.         }
  1004.     }
  1005.     }
  1006. }
  1007.  
  1008.  
  1009. # ◊◊◊◊ Dialog sub-panes ◊◊◊◊ #
  1010.  
  1011. set dialog::_not_global_flag ""
  1012.  
  1013. ## 
  1014.  # -------------------------------------------------------------------------
  1015.  # 
  1016.  # "dialog::flag" --
  1017.  # 
  1018.  #  Builds a dialog-box page to be used for setting global/mode/package
  1019.  #  preferences.  It can contain preferences for flags (on/off), variables,
  1020.  #  list items, mode items, files, folders, apps,...
  1021.  # 
  1022.  # Results:
  1023.  #  part of a script to generate the dialog
  1024.  # 
  1025.  # Side effects:
  1026.  #  sets maxT to the maximum height desired by the dialog
  1027.  # 
  1028.  # --Version--Author------------------Changes-------------------------------
  1029.  #    1.0     Pete Keleher             original
  1030.  #    2.0     <darley@fas.harvard.edu> much more sophisticated (and complex!)
  1031.  # -------------------------------------------------------------------------
  1032.  ##
  1033. proc dialog::flag {flags vars {left 20} {top 40} {title {}}} {
  1034.     global maxT spelling alpha::prefNames dialog::_not_global_flag mode \
  1035.       includeDescriptionsInDialogs
  1036.     if {$includeDescriptionsInDialogs || [info tclversion] >= 8.0} {
  1037.     cache::read index::prefshelp
  1038.     if {[info tclversion] >= 8.0} {
  1039.         upvar help help
  1040.     }
  1041.     if {[regsub {(modeVars)?$} ${dialog::_not_global_flag} "" vprefix]} {
  1042.         append vprefix ","
  1043.     }
  1044.     }
  1045.     
  1046.     if {$title != ""} {
  1047.     lappend args "-t" $title 30 10 400 25
  1048.     incr top 25
  1049.     }
  1050.     # if variable names are very long, switch to 2 columns
  1051.     if {$includeDescriptionsInDialogs} {
  1052.     set perRow 1
  1053.     set width 450
  1054.     } else {
  1055.     if {[maxListItemLength $flags] > 18} {
  1056.         set perRow 2
  1057.         set width 225
  1058.     } else {
  1059.         set perRow 3
  1060.         set width 150
  1061.     
  1062.     }
  1063.     }
  1064.     set height    15
  1065.     
  1066.     set ind 0
  1067.     set l $left
  1068.     foreach f $flags {
  1069.     set fname [quote::Prettify $f]
  1070.     if {$spelling} {text::british fname}
  1071.     if {$includeDescriptionsInDialogs} {
  1072.         if {[info exists prefshelp($vprefix$f)]} {
  1073.         incr top 10
  1074.         eval lappend args [dialog::text \
  1075.           [dialog::helpdescription $prefshelp($vprefix$f)] $l top 90]
  1076.         incr top -14
  1077.         } elseif {[info exists prefshelp($mode,$f)]} {
  1078.         incr top 10
  1079.         eval lappend args [dialog::text \
  1080.           [dialog::helpdescription $prefshelp($mode,$f)] $l top 90]
  1081.         incr top -14
  1082.         }
  1083.     }
  1084.     lappend args "-c" $fname [dialog::getFlag $f] \
  1085.       $l $top [incr l $width] [expr {$top + $height}]
  1086.     if {[incr ind] % $perRow == 0} { set l $left ; incr top $height }
  1087.     if {[info tclversion] >= 8.0} {
  1088.         if {[info exists prefshelp($vprefix$f)]} {
  1089.         lappend help $prefshelp($vprefix$f)
  1090.         } elseif {[info exists prefshelp($mode,$f)]} {
  1091.         lappend help $prefshelp($mode,$f)
  1092.         } else {
  1093.         lappend help ""
  1094.         }
  1095.     }
  1096.     }
  1097.     
  1098.     if {$ind} {
  1099.     set top [expr {$top + 20}]
  1100.     lappend args -p 100 [expr {$top + 27}] 300 [expr {$top + 28}]
  1101.     } 
  1102.     
  1103.     dialog::buildSection $vars top 440 $left args alpha::prefNames
  1104.     incr top 30
  1105.     
  1106.     if {$top > $maxT} {set maxT $top}
  1107.     return $args
  1108. }
  1109.  
  1110. ## 
  1111.  # -------------------------------------------------------------------------
  1112.  # 
  1113.  # "dialog::buildSection" --
  1114.  # 
  1115.  #  Build a dialog box section for a bunch of preferences.  If 'flag_check'
  1116.  #  is set the prefs can be flags or vars, else just vars.
  1117.  #  
  1118.  #  'yvar' is a variable which contains the current y-pos in the box,
  1119.  #  and should be incremented as appropriate by this procedure.
  1120.  #  'width' is the width of the dialog box (default 420)
  1121.  #  'l' is the left indent of all the items (default 20)
  1122.  #  'dialogvar' is the variable onto which all the construction code
  1123.  #  should be lappended.  If it is not given, then this proc will
  1124.  #  return the items.
  1125.  #  'names', if given, is an array containing textual replacements for
  1126.  #  the names of the variables to be used in the box.
  1127.  #  
  1128.  #  A minimal call would be:
  1129.  #  
  1130.  #  set y 20
  1131.  #  set build [dialog::buildSection [list fillColumn] y]
  1132.  #  eval lappend build [dialog::okcancel 20 y]
  1133.  #  set res [eval dialog -w 480 -h $y $build]
  1134.  #  
  1135.  # -------------------------------------------------------------------------
  1136.  ##
  1137. proc dialog::buildSection {vars yvar {width 420} {l 20} {dialogvar ""} {names ""} {flag_check 1}} {
  1138.     global flag::list flag::type allFlags spelling alpha::colors mode::features \
  1139.       includeDescriptionsInDialogs dialog::_not_global_flag mode
  1140.     if {$includeDescriptionsInDialogs || [info tclversion] >= 8.0} {
  1141.     cache::read index::prefshelp
  1142.     if {[info tclversion] >= 8.0} {
  1143.         upvar help help
  1144.     }
  1145.     }
  1146.     if {[regsub {(modeVars)?$} ${dialog::_not_global_flag} "" vprefix]} {
  1147.     append vprefix ","
  1148.     }
  1149.     upvar $yvar t
  1150.     if {$dialogvar != ""} {upvar $dialogvar args}
  1151.     if {$names != ""} { upvar $names name }
  1152.     set height 17
  1153.     set lf 135
  1154.     set r [expr {$l + $width}]
  1155.     set rb [expr {$r -45}]
  1156.     foreach vset $vars {
  1157.     if {[llength $vset] > 1} {
  1158.         incr t 5
  1159.         if {[lindex $vset 0] != ""} {
  1160.         lappend args "-t" "[lindex $vset 0]" [expr {$l -10}] $t $r [expr {$t +15}]
  1161.         incr t 20
  1162.         }
  1163.         set vset [lrange $vset 1 end]
  1164.     }
  1165.     foreach v $vset {
  1166.         if {$includeDescriptionsInDialogs} {
  1167.         if {[info exists prefshelp($vprefix$v)]} {
  1168.             incr t 10
  1169.             eval lappend args [dialog::text $prefshelp($vprefix$v) $l t 90]
  1170.             incr t -14
  1171.         }
  1172.         }
  1173.         if {[info tclversion] >= 8.0} {
  1174.         if {[info exists prefshelp($vprefix$v)]} {
  1175.             lappend help $prefshelp($vprefix$v)
  1176.         } elseif {[info exists prefshelp($mode,$v)]} {
  1177.             lappend help $prefshelp($mode,$v)
  1178.         } else {
  1179.             lappend help ""
  1180.         }
  1181.         }
  1182.         
  1183.         set vv [dialog::getFlag $v]
  1184.         if {[info exists name($v)]} {
  1185.         set vname $name($v)
  1186.         } else {
  1187.         set vname [quote::Prettify $v]
  1188.         }
  1189.         if {$spelling} {
  1190.         text::british vname
  1191.         }
  1192.         if {$flag_check && [lcontains allFlags $v]} {
  1193.         lappend args "-c" $vname $vv $l $t $r [expr {$t + 15}]
  1194.         incr t 15
  1195.         continue
  1196.         }
  1197.         # attempt to indent correctly
  1198.         set len [string length $vname] 
  1199.         if {$len > 40} {
  1200.         lappend args "-t" "$vname:" $l $t [expr {$r -30}] [expr {$t + $height}]
  1201.         incr t 15
  1202.         set indent 100
  1203.         set tle ""
  1204.         } elseif {$len > 17} {
  1205.         set indent [expr {11 + 7 * $len}]
  1206.         set tle {"-t" "$vname:" $l $t [expr {$l + $indent}] [expr {$t + $height}]}
  1207.         } else {
  1208.         set indent $lf
  1209.         set tle {"-t" "$vname:" $l $t [expr {$l + $indent}] [expr {$t + $height}]}
  1210.         }
  1211.         
  1212.         if {[info exists flag::list($v)]} {
  1213.         incr t 5
  1214.         eval lappend args $tle
  1215.         set litems [flag::options $v]
  1216.         if {[regexp "index" [lindex [set flag::list($v)] 0]]} {
  1217.             # set item to index, making sure bad values don't error
  1218.             if {[catch {lindex $litems $vv} vv]} { set vv [lindex $litems 0] }
  1219.         }
  1220.         lappend args "-m" [concat [list $vv] $litems] [expr {$l + $indent -2}] [expr {$t -2}] [expr {$r - 14}] [expr {$t + $height +1}]
  1221.         incr t 17
  1222.         } elseif {[regexp "Colou?r$" $v]} {
  1223.         incr t 5
  1224.         eval lappend args $tle
  1225.         lappend args "-m" [concat [list $vv] ${alpha::colors}] [expr {$l + $indent -2}] [expr {$t -2}] [expr {$r - 14}] [expr {$t + $height +1}]
  1226.         incr t 17
  1227.         } elseif {[regexp "Mode$" $v]} {
  1228.         incr t 5
  1229.         eval lappend args $tle
  1230.         if {$vv == ""} { set vv "<none>" }
  1231.         lappend args "-m" [concat [list $vv] [concat "<none>" [lsort [array names mode::features]]]] [expr {$l + $indent -2}] $t [expr {$r - 14}] [expr {$t + $height +1}]
  1232.         incr t 17
  1233.         } elseif {[regexp "Sig$" $v]} {
  1234.         eval lappend args $tle
  1235.         set vv [dialog::specialView_Sig $vv]
  1236.         lappend args "-t" $vv [expr {$l + $indent}] $t $rb [expr {$t + $height +1}]
  1237.         eval lappend args [dialog::buttonSet $rb $t]
  1238.         incr t 17
  1239.         } elseif {[regexp "SearchPath$" $v]} {
  1240.         eval lappend args $tle
  1241.         if {$vv == ""} {
  1242.             lappend args "-t" "No search paths currently set." \
  1243.               [expr {$l + $indent}] $t $rb [expr {$t + $height +1}]
  1244.             eval lappend args [dialog::buttonSet $rb $t]
  1245.             incr t 17
  1246.         } else {
  1247.             eval lappend args [dialog::buttonSet $rb $t]
  1248.             foreach ppath $vv {
  1249.             lappend args "-t" [dialog::specialView_file $ppath] \
  1250.               [expr {$l + $indent}] $t $rb [expr {$t + $height +1}]
  1251.             incr t 17
  1252.             }
  1253.         }
  1254.         } elseif {[regexp "(Path|Folder)$" $v]} {
  1255.         eval lappend args $tle
  1256.         set vv [dialog::specialView_file $vv]
  1257.         lappend args "-t" $vv [expr {$l + $indent}] $t $rb [expr {$t + $height +1}]
  1258.         eval lappend args [dialog::buttonSet $rb $t]
  1259.         incr t 17
  1260.         } elseif {[info exists flag::type($v)]} {
  1261.         if {[set flag::type($v)] == "funnyChars"} {
  1262.             set vv [quote::Display $vv]
  1263.             set eh [expr {1 + [string length $vv] / 60}]
  1264.             incr t [expr {7 * $eh}]
  1265.             eval lappend args $tle
  1266.             incr t [expr {5 -7 * $eh}]
  1267.             lappend args "-e" $vv [expr {$l + $indent}] $t $r [expr {$t + $eh * $height}]
  1268.             incr t [expr {5 + 17 * $eh}]
  1269.         } else {
  1270.             eval lappend args $tle
  1271.             set vv [dialog::specialView_[set flag::type($v)] $vv]
  1272.             lappend args "-t" $vv [expr {$l + $indent}] $t $rb [expr {$t + $height +1}]
  1273.             eval lappend args [dialog::buttonSet $rb $t]            
  1274.             incr t 17
  1275.         }
  1276.         } else {
  1277.         set eh [expr {1 + [string length $vv] / 60}]
  1278.         incr t [expr {7 * $eh}]
  1279.         eval lappend args $tle
  1280.         incr t [expr {5 -7 * $eh}]
  1281.         lappend args "-e" $vv [expr {$l + $indent}] $t $r [expr {$t + $eh * $height}]
  1282.         incr t [expr {5 + 17 * $eh}]
  1283.         }
  1284.     }
  1285.     }
  1286.     if {$dialogvar == ""} {return $args}
  1287. }
  1288. proc dialog::multipage {data} {
  1289.     dialog::resetModified
  1290.     global maxT
  1291.     # in case internal 'command-buttons' are used in the dialog
  1292.     while 1 {
  1293.     
  1294.     set left 20   
  1295.     
  1296.     set names {}
  1297.     set editItems {}
  1298.     set cmd ""
  1299.     set maxT 0
  1300.     foreach arg [lsort $data] {
  1301.         if {[llength $arg] != 3} {error "Bad structure"}
  1302.         lappend names [lindex $arg 0]
  1303.         set flags [lindex $arg 1]
  1304.         set vars [lindex $arg 2]
  1305.         lappend editItems [eval list $flags $vars]
  1306.         eval lappend cmd "-n" [list [lindex $arg 0]] [dialog::flag $flags $vars]
  1307.     }
  1308.     
  1309.     set buttons [dialog::okcancel $left maxT]
  1310.     set height $maxT
  1311.     if {![info exists chosenName]} {set chosenName [lindex $names 0]}
  1312.     if {[info exists help]} {
  1313.         set res [eval [concat dialog -w 480 -h $height \
  1314.           -t "Preferences:" 40 10 125 30 $buttons \
  1315.           -b "Help" 410 10 460 28 \
  1316.           [list -m [concat [list $chosenName] $names] 140 8 405 30] \
  1317.           $cmd -help] [list [concat [list \
  1318.           "Click here to save the current settings." \
  1319.           "Click here to discard any changes you've made to the settings." \
  1320.           "Click here to display textual help on each item in this dialog." \
  1321.           "Use this popup menu, or the cursor keys to select a \
  1322.           different page of preferences."] $help]]]
  1323.     } else {
  1324.         set res [eval [concat dialog -w 480 -h $height \
  1325.           -t "Preferences:" 40 10 125 30 $buttons \
  1326.           -b "Help" 410 10 460 28 \
  1327.           [list -m [concat [list $chosenName] $names] 140 8 405 30] \
  1328.           $cmd]]
  1329.     }
  1330.     
  1331.     set chosenName [lindex $res 3]
  1332.     if {[lindex $res 0]} {
  1333.         return [list [lrange $res 4 end] [eval concat $editItems]]
  1334.     } else {
  1335.         if {[lindex $res 1]} {
  1336.         error "Cancel chosen"
  1337.         }
  1338.         dialog::rememberChanges [list [lrange $res 4 end] [eval concat $editItems]]
  1339.         # Either help, or some set or describe type button was pressed
  1340.         # We need to ensure we remember anything the user has already
  1341.         # changed.
  1342.         if {[lindex $res 2]} {
  1343.         # help pressed
  1344.         set i [lsearch -exact $names [lindex $res 3]]
  1345.         dialog::describe [lindex $editItems $i] "Description of [lindex $res 3] prefs"
  1346.         } else {
  1347.         # a 'set…' button was pressed
  1348.         dialog::handleSet [lrange $res 4 end] [eval concat $editItems]
  1349.         }
  1350.     }
  1351.     # end of large while loop
  1352.     }
  1353.  
  1354. }
  1355.  
  1356. proc dialog::rememberChanges {values_items} {
  1357.     set res [lindex $values_items 0]
  1358.     set editItems [lindex $values_items 1]
  1359.     unset values_items
  1360.     foreach fset $editItems {
  1361.     if {[llength $fset] > 1} {
  1362.         set fset [lrange $fset 1 end]
  1363.     }
  1364.     foreach flag $fset {
  1365.         set val [lindex $res 0]
  1366.         set res [lrange $res 1 end]
  1367.         dialog::postManipulate
  1368.         dialog::modified $flag $val
  1369.     }
  1370.     }
  1371. }
  1372.  
  1373. proc dialog::onepage {flags vars {title ""}} {
  1374.     dialog::resetModified
  1375.     global maxT
  1376.     while 1 {
  1377.     set left 20
  1378.     set maxT 0
  1379.     set args [dialog::flag $flags $vars 20 10 $title]
  1380.     set height [expr {$maxT + 30}]
  1381.     set buttons [dialog::okcancel $left maxT]
  1382.     set height $maxT
  1383.     if {[info exists help]} {
  1384.         set res [eval [concat dialog -w 480 -h $height $buttons \
  1385.           -b "Help" 410 10 460 28 $args -help] \
  1386.           [list [concat [list \
  1387.           "Click here to save the current settings." \
  1388.           "Click here to discard any changes you've made to the settings." \
  1389.           "Click here to display textual help on each item in this dialog." \
  1390.           ] $help]]]
  1391.     } else {
  1392.         set res [eval [concat dialog -w 480 -h $height $buttons \
  1393.           -b "Help" 410 10 460 28 $args]]]
  1394.     }
  1395.     
  1396.     if {[lindex $res 0]} {
  1397.         return [list [lrange $res 3 end] [concat $flags $vars]]
  1398.     } else {
  1399.         
  1400.         if {[lindex $res 1]} {
  1401.         error "Cancel chosen"
  1402.         } 
  1403.         dialog::rememberChanges [list [lrange $res 3 end] [concat $flags $vars]]
  1404.         if {[lindex $res 2]} {
  1405.         # help
  1406.         dialog::describe [concat $flags $vars] $title
  1407.         } else {
  1408.         dialog::handleSet [lrange $res 3 end] [concat $flags $vars]
  1409.         }
  1410.     }
  1411.     # big while loop end
  1412.     }
  1413.     
  1414. }
  1415.  
  1416. proc dialog::describe {vars {title ""}} {
  1417.     if {$title == ""} {
  1418.     set title "Preferences description"
  1419.     }
  1420.     global flag::list flag::type spelling alpha::colors \
  1421.       dialog::_not_global_flag mode
  1422.     if {[regsub {(modeVars)?$} ${dialog::_not_global_flag} "" vprefix]} {
  1423.     append vprefix ","
  1424.     }
  1425.     cache::read index::prefshelp
  1426.     set height 17
  1427.     set lf 135
  1428.     set l 20
  1429.     set width 420
  1430.     set r [expr {$l + $width}]
  1431.     set rb [expr {$r -45}]
  1432.     set args {}
  1433.     set t 35
  1434.     set height 0
  1435.     set page 1
  1436.     set pages {}
  1437.     foreach vset $vars {
  1438.     if {[llength $vset] > 1} {
  1439.         incr t 5
  1440.         if {[lindex $vset 0] != ""} {
  1441.         lappend args "-t" "[lindex $vset 0]" [expr {$l -10}] $t $r [expr {$t +15}]
  1442.         incr t 20
  1443.         }
  1444.         set vset [lrange $vset 1 end]
  1445.     } else {
  1446.         #do this so that vars that have whitespace padding (used to force dialog position)
  1447.         # are not strip of that space in the next "foreach" statement
  1448.         set vset [list [set vset]]
  1449.     }
  1450.     foreach v $vset {
  1451.         set vv [dialog::getFlag $v]
  1452.         if {[info exists name($v)]} {
  1453.         set vname $name($v)
  1454.         } else {
  1455.         set vname [quote::Prettify $v]
  1456.         }
  1457.         if {$spelling} {
  1458.         text::british vname
  1459.         }
  1460.         if {[info exists prefshelp($vprefix$v)]} {
  1461.         append vname ": " [dialog::helpdescription $prefshelp($vprefix$v)]
  1462.         } elseif {[info exists prefshelp($mode,$v)]} {
  1463.         append vname ": " [dialog::helpdescription $prefshelp($mode,$v)]
  1464.         } else {
  1465.         append vname ": no description"
  1466.         }
  1467.         eval lappend args [dialog::text $vname $l t 60]
  1468.         if {$t > 360} {
  1469.         # make another page
  1470.         eval lappend pages -n [list "Page $page"] $args
  1471.         set args {}
  1472.         incr page
  1473.         if {$t > $height} {set height $t}
  1474.         set t 35
  1475.         }
  1476.         
  1477.     }
  1478.     
  1479.     }
  1480.     if {$page > 1} {
  1481.     set t $height
  1482.     set height [expr {$t + 40}]
  1483.     for {set i 1} {$i <= $page} {incr i} {
  1484.         lappend names "Page $i"
  1485.     }
  1486.     eval lappend pages -n [list "Page $page"] $args        
  1487.     set res [eval [concat dialog -w 480 -h $height \
  1488.       -t [list $title] 60 10 $width 30 \
  1489.       -b "Ok" 30 [expr {$t + 10}] 95 [expr {$t +30}] \
  1490.       [list -m [concat [list [lindex $names 0]] $names] 400 10 475 30] $pages]]
  1491.     } else {
  1492.     set height [expr {$t + 40}]
  1493.     set res [eval [concat dialog -w 480 -h $height \
  1494.       -t [list $title] 60 10 $width 30 \
  1495.       -b "Ok" 30 [expr {$t + 10}] 95 [expr {$t +30}] $args]]
  1496.     }
  1497. }
  1498.  
  1499. proc dialog::helpdescription {hlp} {
  1500.     set hlp [split $hlp |]
  1501.     if {[llength $hlp] <= 1} {
  1502.     return [lindex $hlp 0]
  1503.     }
  1504.     set res ""
  1505.     for {set hi 0} {$hi < [llength $hlp]} {incr hi} {
  1506.     set hitem [lindex $hlp $hi]
  1507.     if {$hitem != ""} {
  1508.         if {$hi == 0} {
  1509.         regsub "click this box\\.?" $hitem "turn this item on" hitem
  1510.         } elseif {$hi == 2} {
  1511.         regsub "click this box\\.?" $hitem "turn this item off" hitem
  1512.         }
  1513.         append res $hitem ". "
  1514.     }
  1515.     }
  1516.     return $res
  1517. }
  1518.  
  1519. # ◊◊◊◊ Dialog utilities ◊◊◊◊ #
  1520. proc dialog::handleSet {res names} {
  1521.     # to account for sub-lists in the list of names
  1522.     foreach n $names {
  1523.     if {[llength $n] > 1} {
  1524.         eval lappend newnames [lrange $n 1 end]
  1525.     } else {
  1526.         lappend newnames $n
  1527.     }
  1528.     }
  1529.     set names $newnames
  1530.     unset newnames
  1531.     global flag::type
  1532.     # a 'set…' button was pressed
  1533.     for {set i 0} {$i < [llength $names]} {incr i} {
  1534.     if {[lindex $res $i] == 1} {
  1535.         set v [lindex $names $i]
  1536.         if {[regexp "SearchPath$" $v]} {
  1537.         set res [buttonAlert "Perform what action to one of the [quote::Prettify $v]s" "Add" "Remove" "Change" "Cancel"]
  1538.         switch -- $res {
  1539.             "Add" {
  1540.             # this set… pressed
  1541.             if {![catch {get_directory -p "New [quote::Prettify $v]:"} newval]} {
  1542.                 set newval [concat [dialog::getFlag $v] [list $newval]] 
  1543.                 dialog::modified $v $newval
  1544.             }
  1545.             }
  1546.             "Remove" {
  1547.             if {![catch {set remove [listpick -p "Remove which items from [quote::Prettify $v]:" -l [dialog::getFlag $v]]}]} {
  1548.                 # remove them
  1549.                 set newval [lremove -l [dialog::getFlag $v] $remove] 
  1550.                 dialog::modified $v $newval
  1551.             }
  1552.             }
  1553.             "Change" {
  1554.             if {![catch {set change [listpick -p "Change which item from [quote::Prettify $v]:" [dialog::getFlag $v]]}]} {
  1555.                 # change it
  1556.                 if {![catch {get_directory -p "Replacement [quote::Prettify $v]:"} newval]} {
  1557.                 set old [dialog::getFlag $v]
  1558.                 set i [lsearch -exact $old $change]
  1559.                 set old [lreplace $old $i $i $newval]
  1560.                 dialog::modified $v $old
  1561.                 }
  1562.             }
  1563.             }
  1564.         }
  1565.         break
  1566.         } elseif {[regexp "(Path|Folder)$" $v]} {
  1567.         # this set… pressed
  1568.         if {![catch {get_directory -p "New [quote::Prettify $v]:"} newval]} {
  1569.             dialog::modified $v $newval
  1570.         }
  1571.         break
  1572.         } elseif {[info exists flag::type($v)]} {
  1573.         dialog::specialSet_[set flag::type($v)] $v
  1574.         break
  1575.         } elseif {[regexp "Sig$" $v]} {
  1576.         global $v
  1577.         set newval [dialog::findApp $v [set $v]]
  1578.         if {$newval != ""} {
  1579.             dialog::modified $v $newval
  1580.         }
  1581.         break
  1582.         }  
  1583.     }
  1584.     }
  1585. }
  1586.  
  1587. proc dialog::setFlag {name val} {
  1588.     global dialog::_not_global_flag
  1589.     if {${dialog::_not_global_flag} != ""} {
  1590.     global ${dialog::_not_global_flag}
  1591.     set ${dialog::_not_global_flag}($name) $val
  1592.     } else {
  1593.     global $name
  1594.     set $name $val
  1595.     }    
  1596. }
  1597.  
  1598. proc dialog::getFlag {name} {
  1599.     global dialog::_modified
  1600.     if {[info exists dialog::_modified($name)]} { 
  1601.     return [set dialog::_modified($name)] 
  1602.     } else {
  1603.     return [dialog::getOldFlag $name]
  1604.     }
  1605. }
  1606. proc dialog::getOldFlag {name} {
  1607.     global dialog::_not_global_flag
  1608.     if {${dialog::_not_global_flag} != ""} {
  1609.     global ${dialog::_not_global_flag}
  1610.     return [set ${dialog::_not_global_flag}($name)]
  1611.     } else {
  1612.     global dialog::_is_global
  1613.     if {[info exists dialog::_is_global]} {
  1614.         global global::_vars
  1615.         if {[info exists global::_vars] \
  1616.           && [set i [lsearch ${global::_vars} $name]] != -1} {
  1617.         return [lindex ${global::_vars} [incr i]]
  1618.         } 
  1619.     }
  1620.     }    
  1621.     global $name
  1622.     if {[info exists $name]} { 
  1623.     return [set $name]
  1624.     } else { 
  1625.     alertnote "Global variable '$name' in the dialog isn't set.\r\
  1626.       I'll try to fix that."
  1627.     return [set $name ""]
  1628.     }
  1629. }
  1630.  
  1631. proc dialog::is_global {script} {
  1632.     global dialog::_is_global
  1633.     set dialog::_is_global 1
  1634.     catch "[list uplevel $script]"
  1635.     unset dialog::_is_global
  1636. }
  1637. proc dialog::resetModified {} {
  1638.     global dialog::_modified
  1639.     if {[info exists dialog::_modified]} {
  1640.     unset dialog::_modified
  1641.     }
  1642. }
  1643.  
  1644. proc dialog::global_adjust_flags {values_items} {
  1645.     global flag::procs modifiedVars global::_vars
  1646.     set res [lindex $values_items 0]
  1647.     set editItems [lindex $values_items 1]
  1648.     unset values_items
  1649.     foreach fset $editItems {
  1650.     if {[llength $fset] > 1} {
  1651.         set fset [lrange $fset 1 end]
  1652.     }
  1653.     foreach flag $fset {
  1654.         set val [lindex $res 0]
  1655.         set res [lrange $res 1 end]
  1656.         dialog::postManipulate
  1657.         if {[info exists global::_vars] \
  1658.           && [set i [lsearch ${global::_vars} $flag]] != -1} {
  1659.         set orig [lindex ${global::_vars} [incr i]]
  1660.         if {$orig != $val} {
  1661.             set global::_vars [lreplace ${global::_vars} $i $i $val]
  1662.             lappend warn_global $flag
  1663.         }
  1664.         } else {
  1665.         global $flag
  1666.         set orig [set $flag]
  1667.         if {$orig != $val} {
  1668.             set $flag $val
  1669.         }
  1670.         }
  1671.         if {$orig != $val} {
  1672.         if {[info exists flag::procs($flag)]} {
  1673.             set proc [set flag::procs($flag)]
  1674.             if {([info procs $proc] != "") && ([llength [info args $proc]] == 0)} {
  1675.             eval $proc
  1676.             } else {
  1677.             eval $proc [list $flag]
  1678.             }
  1679.         }
  1680.         lappend modifiedVars $flag
  1681.         }
  1682.     }
  1683.     }
  1684.     if {[info exists warn_global]} {
  1685.     if {[llength $warn_global] == 1} {
  1686.         set msg "is a global pref"
  1687.     } else {
  1688.         set msg "are global prefs"
  1689.     }
  1690.     alertnote "You modified [join $warn_global {, }] which $msg,\
  1691.       but currently over-ridden by mode-specific values.  If you meant to\
  1692.       modify the latter values, use the mode prefs dialog."
  1693.     }
  1694. }
  1695.  
  1696. proc dialog::postManipulate {} {
  1697.     global flag::list flag::type
  1698.     upvar flag f
  1699.     upvar val v
  1700.     
  1701.     if {[info exists flag::list($f)]} {
  1702.     switch -- [lindex [set l [set flag::list($f)]] 0] {
  1703.         "index" {
  1704.         set v [lsearch -exact [lindex $l 1] $v]
  1705.         }
  1706.         "varindex" {
  1707.         set itemv [lindex $l 1]
  1708.         global $itemv
  1709.         set v [lsearch -exact [set $itemv] $v]
  1710.         }
  1711.     }
  1712.     }
  1713.     if {$v == "<none>" && [regexp "Mode$" $f]} { set v "" }
  1714.     # This check also captures any 'dialog::modified' items
  1715.     # This allows flags which are somehow already set by the
  1716.     # dialog (for instance if called recursively, or if set by embedded
  1717.     # 'Set…' buttons) to be registered as modifed by our calling procedure.
  1718.     if {[regexp "(Path|Folder|Sig)$" $f]} {
  1719.     set v [dialog::getFlag $f]
  1720.     } elseif {[info exists flag::type($f)]} {
  1721.     switch -- [set flag::type($f)] {
  1722.         "binding" {
  1723.         # setup the changed binding
  1724.         set old [dialog::getOldFlag $f]
  1725.         set v [dialog::getFlag $f]
  1726.         if {$old != $v} {
  1727.             global flag::binding
  1728.             if {[info exists flag::binding($f)]} {
  1729.             set m [lindex [set flag::binding($f)] 0]
  1730.             if {[set proc [lindex [set flag::binding($f)] 1]] == 1} {
  1731.                 set proc $f
  1732.             }
  1733.             catch "unBind [keys::toBind $old] [list $proc] $m"
  1734.             catch "Bind [keys::toBind $v] [list $proc] $m"
  1735.             }
  1736.         }
  1737.         }
  1738.         "funnyChars" {
  1739.         set v [quote::Undisplay $v]
  1740.         }
  1741.         default {
  1742.         set v [dialog::getFlag $f]
  1743.         }
  1744.     }
  1745.     }
  1746. }
  1747.  
  1748. proc dialog::modified {name val} {
  1749.     global dialog::_modified
  1750.     set dialog::_modified($name) $val
  1751. }
  1752.  
  1753. # Used on modified mode flags.
  1754. set flag::procs(stringColor) "stringColorProc"
  1755. set flag::procs(commentColor) "stringColorProc"
  1756. set flag::procs(keywordColor) "stringColorProc"
  1757. set flag::procs(funcColor) "stringColorProc"
  1758. set flag::procs(sectionColor) "stringColorProc"
  1759. set flag::procs(bracesColor) "stringColorProc"
  1760.  
  1761. proc global::updateHelperFlags {} {
  1762.     uplevel #0 {
  1763.     set "flagPrefs(Helper Applications)" {}
  1764.     set "varPrefs(Helper Applications)" [info globals *Sig]
  1765.     }
  1766. }
  1767.  
  1768. proc global::updatePackageFlags {} {
  1769.     global flagPrefs varPrefs allFlags modeVars allVars
  1770.     # flags can be in either flagPrefs or varPrefs if we're grouping
  1771.     # preferences according to function
  1772.     set all {}
  1773.     set flagPrefs(Packages) {}
  1774.     set varPrefs(Packages) {}
  1775.     foreach v [array names flagPrefs] {
  1776.     eval lappend all $flagPrefs($v)
  1777.     if {[info exists varPrefs($v)]} {
  1778.         if {[regexp {[{}]} $varPrefs($v)]} {
  1779.         # we're grouping
  1780.         foreach i $varPrefs($v) {
  1781.             if {[llength $i] > 1} {
  1782.             eval lappend all [lrange $i 1 end]
  1783.             } else {
  1784.             lappend all $i
  1785.             }
  1786.         }
  1787.         } else {
  1788.         eval lappend all $varPrefs($v)
  1789.         }
  1790.     }
  1791.     }
  1792.     foreach f $allFlags {
  1793.     if {([lsearch $modeVars $f] < 0)} {
  1794.         if {[lsearch -exact $all $f] == -1} {
  1795.         lappend flagPrefs(Packages) $f
  1796.         }
  1797.     }
  1798.     }
  1799.     
  1800.     foreach f $allVars {
  1801.     if {([lsearch $modeVars $f] < 0)} {
  1802.         if {[lsearch -exact $all $f] == -1} {
  1803.         if {[regexp {Sig$} $f]} {
  1804.             lappend "varPrefs(Helper Applications)" $f
  1805.         } else {
  1806.             lappend varPrefs(Packages) $f
  1807.         }
  1808.         }
  1809.     }
  1810.     }
  1811. }
  1812.  
  1813. #================================================================================
  1814.  
  1815. proc maxListItemLength {l} {
  1816.     set m 0
  1817.     foreach item $l {
  1818.     if {[set mm [string length $item]] > $m} { set m $mm }
  1819.     }
  1820.     return $m
  1821. }
  1822.  
  1823. proc stringColorProc {flag} {
  1824.     global $flag mode
  1825.     
  1826.     if {[set $flag] == "none"} {
  1827.         set $flag "foreground"
  1828.     }
  1829.     if {$flag == "stringColor"} {
  1830.         regModeKeywords -a -s $stringColor $mode
  1831.     } elseif {$flag == "commentColor"} {
  1832.         regModeKeywords -a -c $commentColor $mode
  1833.     } elseif {$flag == "funcColor"} {
  1834.         regModeKeywords -a -f $funcColor $mode
  1835.     } elseif {$flag == "bracesColor"} {
  1836.         regModeKeywords -a -I $bracesColor $mode
  1837.     } elseif {($flag == "keywordColor") || ($flag == "sectionColor")} {
  1838.         alertnote "Change in keyword color will take effect after Alpha restarts."
  1839.         return
  1840.     } else {
  1841.         alertnote "Change in $flag color will take effect after Alpha restarts."
  1842.         return
  1843.     }
  1844.     refresh
  1845. }
  1846.  
  1847. # ◊◊◊◊ Dialog sub-items ◊◊◊◊ #
  1848.  
  1849. proc dialog::buttonSet {x y} {
  1850.     return [list -b Set… $x $y [expr {$x + 45}] [expr {$y + 15}]]
  1851. }
  1852.  
  1853. proc dialog::okcancel {x yy {vertical 0}} {
  1854.     upvar $yy y
  1855.     set i [dialog::button "OK" $x y]
  1856.     if {!$vertical} {
  1857.     incr y -30
  1858.     incr x 80
  1859.     }
  1860.     eval lappend i [dialog::button "Cancel" $x y]
  1861.     return $i
  1862. }
  1863.  
  1864. proc dialog::menu {x yy item {def "def"} {requestedWidth 0}} { 
  1865.     upvar $yy y
  1866.     set m [concat [list $def] $item]
  1867.     if {$requestedWidth == 0} {
  1868.     set popUpWidth 340
  1869.     } else {
  1870.     set popUpWidth $requestedWidth 
  1871.     }
  1872.     
  1873.     if {[info tclversion] < 8.0} {
  1874.     set res [list -m $m $x $y [expr {$x + $popUpWidth}] [expr {$y +20}]]
  1875.     incr y 20
  1876.     } else {
  1877.     incr y -1
  1878.     set res [list -m $m $x $y [expr {$x + $popUpWidth}] [expr {$y +19}]]
  1879.     incr y 21
  1880.     }
  1881.     return $res
  1882. }
  1883. ## 
  1884.  # -------------------------------------------------------------------------
  1885.  # 
  1886.  # "dialog::button" --
  1887.  # 
  1888.  #  Create a dialog string encoding one or more buttons.  'name' is the
  1889.  #  name of the button ("Ok" etc), x is the x position, or if x is null,
  1890.  #  then we use the variable called 'x' in the calling procedure.  yy is
  1891.  #  the name of a variable containing the y position of the button, which
  1892.  #  will be incremented by this procedure.  if args is non-null, it
  1893.  #  contains further name-x-yy values to be lines up next to this button.
  1894.  #  For sequences of default buttons, a spacing of '80' is usual, but
  1895.  #  it's probably best if you just set the 'x' param to "" and let this
  1896.  #  procedure calculate them for you.  See dialog::yesno for a good
  1897.  #  example of calling this procedure.
  1898.  # -------------------------------------------------------------------------
  1899.  ##
  1900. proc dialog::button {name x yy args} { 
  1901.     upvar $yy y
  1902.     if {$x == ""} {
  1903.     unset x
  1904.     upvar x x
  1905.     }
  1906.     set add 65
  1907.     if {[set i [expr {[string length $name] - 7}]] > 0} { 
  1908.     incr add [expr {$i * 7}]
  1909.     }
  1910.     set res [list -b $name $x $y [expr {$x +$add}] [expr {$y +20}]]
  1911.     incr x $add
  1912.     incr x 15
  1913.     if {[llength $args]} {
  1914.     eval lappend res [eval dialog::button $args]
  1915.     return $res
  1916.     }
  1917.     incr y 30
  1918.     return $res
  1919. }
  1920. proc dialog::title {name w} {
  1921.     set l [expr {${w}/2 - 4 * [string length $name]}]
  1922.     if {$l < 0} {set l 0}
  1923.     return [list -t $name $l 10 [expr {$w - $l}] 25]
  1924. }
  1925. ## 
  1926.  # -------------------------------------------------------------------------
  1927.  # 
  1928.  # "dialog::text" --
  1929.  # 
  1930.  #  Creates a text box wrapping etc the text to fit appropriately.
  1931.  #  In the input text 'name', "\r" is used as a paragraph delimiter,
  1932.  #  and "\n" is used to force a linebreak.  Paragraphs have a wider
  1933.  #  spread.
  1934.  # -------------------------------------------------------------------------
  1935.  ##
  1936. proc dialog::text {name x yy {split 0}} {
  1937.     upvar $yy y
  1938.     if {!$split || $name == ""} {
  1939.     set res [list -t $name $x $y [expr {$x + 7 * [string length $name]}] \
  1940.       [expr {$y +15}]]
  1941.     incr y 18
  1942.     } else {
  1943.     global fillColumn
  1944.     if {[info exists fillColumn]} {
  1945.         set f $fillColumn
  1946.     }
  1947.     set fillColumn $split
  1948.     set name [string trim $name]
  1949.     set paragraphList [split $name "\r"]
  1950.     foreach para $paragraphList {
  1951.         set lines ""
  1952.         foreach line [split $para "\n"] {
  1953.         lappend lines [breakIntoLines $line]
  1954.         }
  1955.         set lines [join $lines "\r"]
  1956.         foreach line [split $lines "\r"] {
  1957.         eval lappend res [list -t $line $x $y [expr {$x + 4+ 8 * [string length $line]}] \
  1958.           [expr {$y +15}]]
  1959.         incr y 18
  1960.         }
  1961.         incr y 10
  1962.     }
  1963.     if {[info exists f]} {
  1964.         set fillColumn $f
  1965.     } else {
  1966.         unset fillColumn
  1967.     }
  1968.     }
  1969.     return $res
  1970. }
  1971. proc dialog::edit {name x yy chars {cols 1}} {
  1972.     upvar $yy y
  1973.     set res [list -e $name $x $y [expr {$x + 10 * $chars}] [expr {$y + 15 * $cols}]]
  1974.     incr y [expr {5 + 15*$cols}]
  1975.     return $res
  1976. }
  1977. proc dialog::textedit {name default x yy chars {height 1}} {
  1978.     upvar $yy y
  1979.     set res [list -t $name $x $y [expr {$x + 8 * [string length $name]}]\
  1980.       [expr {$y +16}] \
  1981.       -e $default $x [expr {$y + 20}] [expr {$x + 10 * $chars}] \
  1982.       [expr {$y +20 + 16*$height}]]
  1983.     incr y [expr {24 + 16*$height}]
  1984.     return $res
  1985. }
  1986. proc dialog::checkbox {name default x yy} {
  1987.     upvar $yy y
  1988.     set res [list -c $name $default $x $y]
  1989.     lappend res [expr {$x + [dialog::_reqWidth $name]}] [expr {$y +15}]
  1990.     incr y 18
  1991.     return $res
  1992. }
  1993.  
  1994. proc dialog::_reqWidth {args} {
  1995.     set w 0
  1996.     foreach name $args {
  1997.     set c [regsub -all -nocase {[wm]} $name "" ""]
  1998.     set d [regsub -all {[ il',;:.]} $name "" ""]
  1999.     set len [expr {11 * [string length $name] + 6 * $c - 5 * $d}]
  2000.     if {$len > $w} {
  2001.         set w $len
  2002.     }
  2003.     }
  2004.     return $w
  2005. }
  2006.  
  2007. # ◊◊◊◊ Multiple bindings dialogs ◊◊◊◊ #
  2008.  
  2009. proc dialog::arrayBindings {name array {for_menu 0}} {
  2010.     upvar $array a
  2011.     foreach n [array names a] {
  2012.     lappend l [list $a($n) $n]
  2013.     }
  2014.     if {[info exists l]} {
  2015.     eval dialog::adjustBindings [list $name modified "" $for_menu] $l
  2016.     }
  2017.     array set a [array get modified]
  2018. }
  2019.  
  2020. ## 
  2021.  # -------------------------------------------------------------------------
  2022.  # 
  2023.  # "dialog::adjustBindings" --
  2024.  # 
  2025.  #  'args' is a list of pairs.  The first element of each pair is the 
  2026.  #  menu binding, and the second element is a descriptive name for the
  2027.  #  element. 'array' is the name of an array in the calling proc's
  2028.  #  scope which is used to return modified bindings.
  2029.  # 
  2030.  # Results:
  2031.  #  
  2032.  # --Version--Author------------------Changes-------------------------------
  2033.  #    1.0     Johan Linde               original for html mode
  2034.  #    1.1     <darley@fas.harvard.edu> general purpose version
  2035.  #    1.2     Johan Linde              split into two pages when many items
  2036.  # -------------------------------------------------------------------------
  2037.  ##
  2038. proc dialog::adjustBindings {name array {mod {}} {for_menu 1} args} {
  2039.     global screenHeight
  2040.     regsub -all {\"\(-\"} $args "" items
  2041.     upvar $array key_changes
  2042.     
  2043.     foreach it $items {
  2044.     if {[info exists key_changes([lindex $it 1])]} {
  2045.         set tmpKeys([lindex $it 1]) $key_changes([lindex $it 1])
  2046.     } else {
  2047.         set tmpKeys([lindex $it 1]) [lindex $it 0]
  2048.     }
  2049.     }
  2050.     # do we return modified stuff?
  2051.     if {$mod != ""} { upvar $mod modified }
  2052.     set modified ""
  2053.     set page "Page 1 of $name"
  2054.     while {1} {
  2055.     # Build dialog.
  2056.     set twoWindows 0
  2057.     set box ""
  2058.     set h 30
  2059.     foreach it $items {
  2060.         if {$it == "(-"} {continue}
  2061.         set w 210
  2062.         set w2 370
  2063.         set key $tmpKeys([lindex $it 1])
  2064.         set key1 [dialog::specialView_binding $key]
  2065.         set it2 [split [lindex $it 1] /]
  2066.         if {[llength $it2] == 1} {
  2067.         lappend box -t [lindex $it2 0] 65 $h 205 [expr {$h + 15}] -t $key1 $w $h $w2 [expr {$h + 15}]
  2068.         eval lappend box [dialog::buttonSet 10 $h]
  2069.         incr h 17
  2070.         } else {
  2071.         lappend box -t [lindex $it2 0] 65 $h 205 [expr {$h + 15}] -t $key1 $w $h $w2 [expr {$h + 15}]
  2072.         eval lappend box [dialog::buttonSet 10 [expr {$h +8}]]
  2073.         incr h 17
  2074.         if {$key1 != "<no binding>"} {regsub {((ctrl-)?(shift-)?)(.*)} $key1 {\1opt-\4} key1}
  2075.         lappend box -t [lindex $it2 1] 65 $h 205 [expr {$h + 15}] -t $key1 $w $h $w2 [expr {$h + 15}]
  2076.         incr h 17
  2077.         }
  2078.         if {$it != [lindex $items [expr {[llength $items] -1}]] && !$twoWindows && [set twoWindows [expr {$h + 100 > $screenHeight}]]} {
  2079.         set box " -n [list [concat Page 1 of $name]] $box -n [list [concat Page 2 of $name]] "
  2080.         set hmax $h; set h 30
  2081.         }
  2082.     }
  2083.     if {[info exists hmax]} {set h $hmax}
  2084.     if {$twoWindows} {
  2085.         set top "-m [list [list $page [concat Page 1 of $name] [concat Page 2 of $name]]] 10 10 370 25"
  2086.     } else {
  2087.         set top "-t [list $name] 50 10 250 25"
  2088.     }
  2089.     set buttons "-b OK 20 [expr {$h + 10}] 85 [expr {$h + 30}]  -b Cancel 105 [expr {$h + 10}] 170 [expr {$h + 30}]"
  2090.     set values [eval [concat dialog -w 380 -h [expr {$h + 40}]  $buttons $top $box]]
  2091.     if {$twoWindows} {set page [lindex $values 2]}
  2092.     if {[lindex $values 1]} {
  2093.         # Cancel
  2094.         return "Cancel"
  2095.     } elseif {[lindex $values 0]} {
  2096.         # Save new key bindings
  2097.         foreach it $modified {
  2098.         set key_changes($it) $tmpKeys($it)
  2099.         }
  2100.         return
  2101.     } else {
  2102.         # Get a new key.
  2103.         set it [lindex [lindex $items [expr {[lsearch $values 1] - 2 - $twoWindows}]] 1]
  2104.         if {![catch {dialog::getAKey $it $tmpKeys($it) $for_menu} newKey]  && $newKey != $tmpKeys($it)} {
  2105.         set tmpKeys($it) $newKey
  2106.         lappend modified $it
  2107.         }
  2108.     }
  2109.     }
  2110. }
  2111.  
  2112. # ◊◊◊◊ Manipulation of special pref types ◊◊◊◊ #
  2113.  
  2114. proc dialog::specialView_binding {key} {
  2115.     append key1 [keys::modifiersTo $key "verbose"]
  2116.     append key1 [keys::verboseKey $key]
  2117.     if {$key1 == ""} { return "<no binding>" }
  2118.     return $key1
  2119. }
  2120.  
  2121. proc dialog::specialSet_binding {v {menu 0}} {
  2122.     # Set… pressed
  2123.     set oldB [dialog::getFlag $v]
  2124.     if {![catch {dialog::getAKey [quote::Prettify $v] $oldB $menu} newKey] && $newKey != $oldB} {
  2125.     dialog::modified $v $newKey
  2126.     }
  2127. }
  2128.  
  2129. proc dialog::specialView_menubinding {key} {
  2130.     dialog::specialView_binding $key
  2131. }
  2132.  
  2133. proc dialog::specialSet_menubinding {v} {
  2134.     dialog::specialSet_binding $v 1
  2135. }
  2136. proc dialog::specialView_Sig {vv} {
  2137.     if {$vv != ""} {
  2138.     if {[catch {nameFromAppl $vv} path]} {
  2139.         return "Unknown application with sig '$vv'"
  2140.     } else {
  2141.         return [dialog::specialView_file $path]
  2142.     }
  2143.     }
  2144.     return ""
  2145. }
  2146.  
  2147. proc dialog::specialView_io-file {vv} {
  2148.     dialog::specialView_file $vv
  2149. }
  2150.  
  2151. proc dialog::specialView_file {vv} {
  2152.     if {[set sl [string length $vv]] > 33} {
  2153.     set vv "[string range $vv 0 8]...[string range $vv [expr {$sl -21}] end]"
  2154.     }
  2155.     return $vv
  2156. }
  2157. proc dialog::specialSet_file {v} {
  2158.     # Set… pressed
  2159.     set old [dialog::getFlag $v]
  2160.     if {![catch {getfile [quote::Prettify "New $v"] [dialog::getFlag $v]} ff] \
  2161.       && $ff != $old} {
  2162.     dialog::modified $v $ff
  2163.     }
  2164. }
  2165. proc dialog::specialSet_io-file {v} {
  2166.     # Set… pressed
  2167.     set old [dialog::getFlag $v]
  2168.     if {![catch {putfile [quote::Prettify "New $v"] [dialog::getFlag $v]} ff] \
  2169.       && $ff != $old} {
  2170.     dialog::modified $v $ff
  2171.     }
  2172. }
  2173.  
  2174.  
  2175.  
  2176.  
  2177.  
  2178.